home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / OBJ1_2.ZIP;1 / C_MENU.PRG < prev    next >
Encoding:
Text File  |  1993-01-21  |  28.7 KB  |  870 lines
  1. //*****************************************************************************
  2. // C_Menu.prg
  3. // Menu class for OBJECT v2.03
  4. // Copyright (c) 1991, JHK, JHK-Software, Piestany
  5. // Please compile with: /N/M/W/A
  6. //-----------------------------------------------------------------------------
  7.  
  8. #include "Set.ch"
  9. #include "InKey.ch"
  10. #include "Object.ch"
  11. #include "SetCurs.ch"
  12.  
  13. #define nQuitRequest -9999  //quit from Menu'Process()
  14.  
  15. static Cmd:=0           //last Accelerator command. (assume run last task)
  16. static ActiveMenu       //current active menu object
  17.  
  18. static Stack:=nil       //stack for building menu (Menu:Data)  ƒø   for building
  19. static Count:=0         //index into Menu:Block                ƒ¡ƒ> menu array.
  20.  
  21. static ExistIntItems:=false  //flag for add an internal items in Menu:Process
  22.  
  23. create class Menu
  24.   export:
  25.   var Color   // m->Color:Menu
  26.   var Data    // {}             //menu data structure (array of MD)
  27.   var Block   // {}             //code blocks for each item in menu
  28.   var Avail   // {}             //availability for each item in menu
  29.   var HotKeys // {}             //{{nKey,idx},..} indexes into Menu:Data for Accelerators
  30.   var Idx     // 1              //previously selected item in bar menu
  31.   var NewTask // nil;           //maximum priority for activate this new task (NewTask is pointer into Menu:Block array)
  32.   method New=MenuNew             //o:New()
  33.   method Init=MenuInit           //o:Init()
  34.   method Password=MenuPassword         //o:Password(SelfID) //called from Menu:Process()
  35.   method AddBar=MenuAddBar             //o:AddBar(cName,bAction,bPreBlock,bPostBlock),;
  36.   method AddMenu=MenuAddMenu           //o:AddMenu(cName,nHotKey,bPreBlock,bPostBlock),;
  37.   method AddItem=MenuAddItem           //o:AddItem(cName,bAction,nHotKey,bPreBlock,bPostBlock),;
  38.   method AddCheck=MenuAddCheck         //o:AddCheck(cName,bAction,nHotKey,bPreBlock,bPostBlock),;
  39.   method AddView=MenuAddView           //o:AddView(cName,cWinName,oV,nHotKey,nVKey,nEKey,nGKey,nLKey,nIKey,nFKey,nRKey,nMKey),;
  40.   method PopSubLevel=MenuPopSubLevel   //o:PopSubLevel(),;
  41.   method DisableItem=MenuDisableItem   //o:DisableItem(nItemID,lSubMenu),;
  42.   method EnableItem=MenuEnableItem     //o:EnableItem(nItemID,lSubMenu),;
  43.   method GetMD=MenuGetMD               //o:GetMD(nItemID),;                //return MD object, of this menu item
  44.   method GetParentMD=MenuGetParentMD   //o:GetParentMD(nItemID),;          //return Parents MD object, of this menu item
  45.   method Process=MenuProcess           //o:Process(),;
  46.   method BarEntry=MenuBarEntry         //o:BarEntry(aAccelerators),;
  47.   method ItemEntry=MenuItemEntry       //o:ItemEntry(MD,CurSize,aAccelerators),;    //must be set Cursor position!
  48.   method Done=MenuDone                 //o:Done(lConfirm)
  49.   endclass
  50.  
  51.  
  52. //*****************************************************************************
  53. // Menu:New() --> self
  54. // initialize new object
  55. //
  56. constructor MenuNew()
  57.   ::Color:= m->Color:Menu
  58.   ::Data:= {}
  59.   ::Block:= {}
  60.   ::Avail:= {}
  61.   ::HotKeys:= {}
  62.   ::Idx:= 1
  63.   ::NewTask:= nil
  64.   return(self)
  65.  
  66.  
  67. //-----------------------------------------------------------------------------
  68. // GetActiveMenu() --> nil
  69. // return last active menu
  70. //
  71. function GetActiveMenu()
  72.   return(ActiveMenu)
  73.  
  74.  
  75. //-----------------------------------------------------------------------------
  76. // SetMenuCmd(new) --> nil
  77. // get/set menu Cmd (command)
  78. //
  79. function SetMenuCmd(new)
  80.   return Cmd update with new
  81.  
  82.  
  83. //*****************************************************************************
  84. // Menu:Init() --> true
  85. // Initialize the menu system.
  86. //
  87. method function MenuInit()
  88.   TestAllDbfReIndex()
  89.   DOut(ResTxt(169))
  90.   Cmd:=0
  91.   object Stack of Stack init
  92.   ActiveMenu:=self                                    //save active menu
  93.   SetKey(K_F10,{||(Cmd:=K_F10),StuffKey(nSwapTask)})  //menu
  94.   return(true)
  95.  
  96.  
  97. //*****************************************************************************
  98. // Menu:Password(SelfID) --> true
  99. // Change user(s) password, (supevisor menu)
  100. //
  101. method function MenuPassword(SelfID)
  102.   if UserNo()==1
  103.     ChPswSup(self,SelfID)
  104.   else
  105.     ChPswUsr(self,SelfID)
  106.   endif
  107.   return(true)
  108.  
  109.  
  110. //-----------------------------------------------------------------------------
  111. // Menu::ChPswSup(SelfID) --> true
  112. // main supervisor menu
  113. //
  114. static function ChPswSup(Menu,SelfID)
  115.   local i
  116.   i:=Alert(ResTxt(101),ResTxt(128))
  117.   do case
  118.     case i==1; ChPswUsr(Menu)
  119.     case i==2; SetUsers(Menu,SelfID)
  120.   endcase
  121.   return(true)
  122.  
  123.  
  124. //-----------------------------------------------------------------------------
  125. // Menu::SetUsers(SelfID) --> true
  126. // supervisor pasword table
  127. //
  128. static function SetUsers(Menu,SelfID)
  129.   local Arr:={}
  130.   local OldSel:=Select()
  131.   local object AB of ABrowse
  132.   SaveDOut(ResTxt(165))
  133.   AB:GoodInit(ResTxt(026),-3,-3,8,2*nLenPsw+Len(ResTxt(180))+3+Max(Len(ResTxt(133)),Len(ResTxt(025)))+8)
  134.   AB:CanSwap:=false
  135.   AB:AddBlock(,ResTxt(023),"SYS:->SUP_ID",   {|x|if(nil==x,AB:Arr[AB:N,1],AB:Arr[AB:N,1]:=x)}, {||if(AB:N>2,AB:DoGet(),StuffKey(K_RIGHT))} )
  136.   AB:AddBlock(,ResTxt(024),"SYS:->SUP_PSW",  {|x|if(nil==x,AB:Arr[AB:N,2],AB:Arr[AB:N,2]:=x)}, {||if(AB:N<>2,AB:DoGet(),Alert(ResTxt(184)))} )
  137.   AB:AddBlock(,ResTxt(025),"SYS:->SUP_MENU", {||ResTxt(133)}, {||if(AB:N>1,Security(Menu,AB,SelfID),Alert(ResTxt(102)))} )
  138.   AB:AddBlock(,ResTxt(180),"SYS:->SUP_LEVEL",{|x|if(nil==x,AB:Arr[AB:N,4],AB:Arr[AB:N,4]:=x)}, {||if(AB:N>1,AB:DoGet(),PauseKey())} )
  139.   select (cBasic)
  140.   net flock continue
  141.   if NetErr(); AB:Done(); select (OldSel); return(true); endif
  142.   Menu:DisableItem(SelfID)
  143.   DbEval({||AAdd(Arr,{Convert(field->U,,false),Convert(field->P,,false),field->S,field->L})})
  144.   select (OldSel)
  145.   AB:Arr:=Arr
  146.   AB:DoneBlock:={||if(SetDone(AB,SelfID),Menu:EnableItem(SelfID),false)}
  147.   AB:InsBlock:={|AB|DoInsert(AB)}
  148.   AB:DelBlock:={|AB|DoDelete(AB)}
  149.   RestDOut()
  150.   AB:Process()
  151.   return(true)
  152.  
  153.  
  154. static function DoInsert(AB)
  155.   local a:={}
  156.   AAdd(a,Replicate(" ",Len(AB:Arr[1,1])))
  157.   AAdd(a,Replicate(" ",Len(AB:Arr[1,2])))
  158.   AAdd(a,Replicate("x",Len(AB:Arr[1,3])))
  159.   AAdd(a,AB:Arr[2,4])
  160.   AAdd(AB:Arr,a)
  161.   AB:Tb:GoBottom()
  162.   AB:Tb:Home()
  163.   AB:Tb:RefreshAll()
  164.   while !AB:Tb:Stabilize(); endwhile
  165.   StuffKey(K_ENTER)
  166.   return(true)
  167.  
  168.  
  169. static function DoDelete(AB)
  170.   if AB:N>2 and Alert(ResTxt(105),ResTxt(123))==1
  171.     ATrueDel(AB:Arr,AB:N)
  172.     AB:Tb:RefreshAll()
  173.   endif
  174.   return(true)
  175.  
  176.  
  177. //-----------------------------------------------------------------------------
  178. // AB::SetDone(SelfID) --> true/false
  179. // save edited array into database
  180. //
  181. static function SetDone(AB,SelfID)
  182.   local OldSel:=Select()
  183.   SaveDOut(ResTxt(173))
  184.   select (cBasic)
  185.   recall all
  186.   while LastRec()<Len(AB:Arr); DbAppend(); endwhile
  187.   go top
  188.   AEval(AB:Arr,{|e|SaveRec(e)})
  189.   delete rest
  190.   commit
  191.   net unlock
  192.   select (OldSel)
  193.   RestDOut()
  194.   return(true)
  195.  
  196. static function SaveRec(e)
  197.   field->U:=Convert(e[1],nLenPsw)
  198.   field->P:=Convert(e[2],nLenPsw)
  199.   field->S:=e[3]
  200.   field->L:=e[4]
  201.   skip
  202.   return(true)
  203.  
  204. //-----------------------------------------------------------------------------
  205. // Menu::Security(AB,SelfID) --> true
  206. // set security AB:Arr[ AB:N, 3 ]  //type String250.
  207. //
  208. static function Security(Menu,AB,SelfID)
  209.   local Arr:={}
  210.   local i,j:=0
  211.   local md:=Menu:Data
  212.   local object UpAb of UpABrowse
  213.   local OldShow:=SetDialog(true)
  214.   local OldHelp:=SetHelpIdx(true)
  215.   SaveDOut(ResTxt(166))
  216.   ReadMenu(md,j,@Arr)
  217.   j:=AWidth(Arr)+2
  218.   for i:=1 to Len(Arr)
  219.     Arr[i]:=StrTran(StrTran(StrTran(Arr[i],"~"),""," "),"˚"," ")
  220.     Arr[i]:=PadR(SubStr(AB:Arr[AB:N,3],i,1)+" "+Arr[i],j)
  221.   endfor
  222.   UpAb:GoodInit(ResTxt(025)+": "+AllTrim(AB:Arr[AB:N,1]),-3,-3,Min(Len(Menu:Avail),MaxRow()-5))
  223.   UpAb:AddBlock(,,"SYS:->SUP_IN_MENU",{|x|if(nil==x,UpAb:Arr[UpAb:N],UpAb:Arr[UpAb:N]:=x)}, {||DoGet(UpAb,AB,SelfID)} )
  224.   (UpAb:Tb:GetColumn(1)):ColorBlock:={|c|if(Left(c,1)=="˚",{nNormal,nSelected},{nExtension,nUnSelect})}
  225.   UpAb:Arr:=Arr
  226.   UpAb:CanAppend:=false
  227.   UpAb:Paint()
  228.   DOut(ResTxt(154)); SetDialog(false)
  229.   SaveHelpIdx({14}); SetHelpIdx(false)
  230.   UpAb:Process()
  231.   SetHelpIdx(true); RestHelpIdx(); SetHelpIdx(OldHelp)
  232.   SetDialog(true); RestDOut(); SetDialog(OldShow)
  233.   IEval(Len(UpAb:Arr),{|i|AB:Arr[AB:N,3]:=Stuff(AB:Arr[AB:N,3],i,1,Left(UpAb:Arr[i],1))})
  234.   UpAb:Done()
  235.   SetLastKey(0)
  236.   return(true)
  237.  
  238. static function ReadMenu(md,ofs,Arr)
  239.   AEval(md,{|e|AAdd(Arr,Replicate(" ",if(ofs==0,2,ofs))+e:Name), if(!Empty(e:Data),ReadMenu(e:Data,ofs+2,@Arr),nil)})
  240.   return(true)
  241.  
  242. static function DoGet(UpAb,AB,SelfID)
  243.   local b:=(UpAb:Tb:GetColumn(1)):Block
  244.   local c:=Eval(b)
  245.   local sp:=Len(c)-Len(LTrim(SubStr(c,2)))-1
  246.   local ln:=Len(UpAb:Arr)
  247.   clear keyboard
  248.   if AB:N==2 and UpAb:N==SelfID
  249.     Eval(b,"x"+SubStr(c,2))  //guest cannot change password
  250.   else
  251.     Eval(b,if(Left(c,1)=="˚","x","˚")+SubStr(c,2))
  252.   endif
  253.   UpAb:Tb:RefreshCurrent()
  254.   UpAb:Tb:Down()
  255.   while !UpAb:Tb:Stabilize(); endwhile
  256.   return(true)
  257.  
  258.  
  259. //-----------------------------------------------------------------------------
  260. // Menu::ChPswUsr(SelfID) --> true
  261. // Change one (user) pasword, SelfID not used because this is non thread task.
  262. //
  263. static function ChPswUsr(Menu)
  264.   local New1Psw,New2Psw,OldSel
  265.   local RecN:=UserNo()
  266.   local R:=Int(MaxRow()/2-5)
  267.   local object UpW of UpWindow; UpW:Init(ResTxt(027),R,,8,,m->Color:Help)
  268.   R:=Int(UpW:Row+UpW:RowSize/2-1)
  269.   New1Psw:=New2Psw:=Replicate(" ",nLenPsw)
  270.   UpW:Top(false)
  271.   New1Psw:=Convert(EditItPrim(New1Psw,ResTxt(018),,R,,,"SYS:->EDIT_PSW",true),nLenPsw)
  272.   if LastKey()==K_ESC; AbortPassword(UpW); return(false); endif
  273.   New2Psw:=Convert(EditItPrim(New2Psw,ResTxt(019),,R,,,"SYS:->EDIT_PSW",true),nLenPsw)
  274.   if LastKey()==K_ESC; AbortPassword(UpW); return(false); endif
  275.   if !(New1Psw==New2Psw)
  276.     Alert(ResTxt(119))
  277.   else
  278.     OldSel:=Select()
  279.     select (cBasic)
  280.     if NetErr()
  281.       Alert(ResTxt(120))
  282.     else
  283.       go UserNo()
  284.       net rlock continue
  285.       if NetErr()
  286.         Alert(ResTxt(120))
  287.       else
  288.         field->P:=New1Psw
  289.         commit
  290.         net unlock
  291.         Alert(ResTxt(118))
  292.       endif
  293.     endif
  294.     select (OldSel)
  295.   endif
  296.   UpW:Done()
  297.   SetLastKey(0)
  298.   return(true)
  299.  
  300. static procedure AbortPassword(UpW)
  301.   Alert(ResTxt(119))
  302.   UpW:Done()
  303.   SetLastKey(0)
  304.   return
  305.  
  306.  
  307. //*****************************************************************************
  308. // Menu:AddBar(cName,bAction,bPreBlock,bPostBlock) --> true
  309. // Add new bar item into menu object
  310. //
  311. method function MenuAddBar(cName,bAction,bPreBlock,bPostBlock)
  312.   local nKey
  313.   local object MD of MD
  314.   MD:ID:=++Count
  315.   HelpAssoc("MENU->"+NTrim(HelpReserved(,+1)),StrTran(cName,"~"),HelpReserved())
  316.   MD:Help:=HelpReserved()
  317.   store value bPreBlock into MD:PreBlock
  318.   store value bPostBlock into MD:PostBlock
  319.   Stack:Init()
  320.   AAdd(::Avail,false)
  321.   MD:Name:=cName
  322.   if Empty(bAction)
  323.     AAdd(::Block,{Len(::Data)+1})
  324.     MD:Data:={}
  325.     Stack:Push(MD:Data)
  326.   else
  327.     AAdd(::Block,bAction)
  328.   endif
  329.   AAdd(::Data,MD)
  330.   nKey:=At("~",cName)
  331.   if nKey>0
  332.     nKey:=c2AltKey(SubStr(cName,nKey+1,1))
  333.     AAdd(::HotKeys,{nKey,Count})
  334.     SetKey(nKey,{||(Cmd:=LastKey()),StuffKey(nSwapTask)})  //menu
  335.   endif
  336.   return(true)
  337.  
  338.  
  339. //*****************************************************************************
  340. // c2AltKey( Ch ) --> alt_inkey_code   (this function are written in Nantucket)
  341. // transform char into alt inkey code
  342. //
  343. static function c2AltKey(Ch)
  344.   local nAltKey
  345.   static Table:={{ 65, K_ALT_A },;
  346.                  { 66, K_ALT_B },;
  347.                  { 67, K_ALT_C },;
  348.                  { 68, K_ALT_D },;
  349.                  { 69, K_ALT_E },;
  350.                  { 70, K_ALT_F },;
  351.                  { 71, K_ALT_G },;
  352.                  { 72, K_ALT_H },;
  353.                  { 73, K_ALT_I },;
  354.                  { 74, K_ALT_J },;
  355.                  { 75, K_ALT_K },;
  356.                  { 76, K_ALT_L },;
  357.                  { 77, K_ALT_M },;
  358.                  { 78, K_ALT_N },;
  359.                  { 79, K_ALT_O },;
  360.                  { 80, K_ALT_P },;
  361.                  { 81, K_ALT_Q },;
  362.                  { 82, K_ALT_R },;
  363.                  { 83, K_ALT_S },;
  364.                  { 84, K_ALT_T },;
  365.                  { 85, K_ALT_U },;
  366.                  { 86, K_ALT_V },;
  367.                  { 87, K_ALT_W },;
  368.                  { 88, K_ALT_X },;
  369.                  { 89, K_ALT_Y },;
  370.                  { 90, K_ALT_Z }}
  371.   Ch:=Asc(Upper(Ch))                     //ascii uppercase code
  372.   nAltKey:=AScan(Table,{|x|x[1]==Ch})
  373.   return(if(nAltKey>0, Table[nAltKey,2], 0))
  374.  
  375.  
  376. //*****************************************************************************
  377. // Menu:AddMenu(cName,nHotKey,bPreBlock,bPostBlock) --> true
  378. // Add new menu into last element in menu.
  379. //
  380. method function MenuAddMenu(cName,nHotKey,bPreBlock,bPostBlock)
  381.   local a,Arr:={}
  382.   local object MD of MD
  383.   MD:ID:=++Count
  384.   HelpAssoc("MENU->"+NTrim(HelpReserved(,+1)),StrTran(cName,"~"),HelpReserved())
  385.   MD:Help:=HelpReserved()
  386.   AAdd(::Avail,false)
  387.   AAdd(::Block,nil)
  388.   MD:Name:=" "+cName+" "
  389.   MD:Data:={}
  390.   store value bPreBlock into MD:PreBlock
  391.   store value bPostBlock into MD:PostBlock
  392.   AAdd(Stack:Top(),MD)
  393.   Stack:Push(MD:Data)
  394.   if nHotKey<>nil
  395.     a:=::Data
  396.     while !Empty(a)
  397.       AAdd(Arr,Len(a))
  398.       a:=ATail(a):Data
  399.     endwhile
  400.     ::Block[Count]:=Arr
  401.     AAdd(::HotKeys,{nHotKey,Count})
  402.     SetKey(nHotKey,{||(Cmd:=LastKey()),StuffKey(nSwapTask)})
  403.   endif
  404.   return(true)
  405.  
  406.  
  407. //*****************************************************************************
  408. // Menu:AddItem(cName,bAction,nHotKey,bPreBlock,bPostBlock) --> true
  409. // Add new item into last element in menu.
  410. //
  411. method function MenuAddItem(cName,bAction,nHotKey,bPreBlock,bPostBlock)
  412.   local object MD of MD
  413.   default bAction to {||nil}
  414.   MD:ID:=++Count
  415.   HelpAssoc("MENU->"+NTrim(HelpReserved(,+1)),StrTran(cName,"~"),HelpReserved())
  416.   MD:Help:=HelpReserved()
  417.   MD:Name:="  "+cName+" "
  418.   store value bPreBlock into MD:PreBlock
  419.   store value bPostBlock into MD:PostBlock
  420.   AAdd(::Avail,false)
  421.   AAdd(::Block,bAction)
  422.   AAdd(Stack:Top(),MD)
  423.   if nHotKey<>nil
  424.     AAdd(::HotKeys,{nHotKey,Count})
  425.     SetKey(nHotKey,{||(Cmd:=LastKey()),StuffKey(nSwapTask)})
  426.   endif
  427.   return(true)
  428.  
  429.  
  430. //*****************************************************************************
  431. // Menu:AddCheck(cName,bAction,nHotKey,bPreBlock,bPostBlock) --> true
  432. // Add new checked item into last element in menu.
  433. //
  434. method function MenuAddCheck(cName,bAction,nHotKey,bPreBlock,bPostBlock)
  435.   local object MD of MD
  436.   MD:ID:=++Count
  437.   HelpAssoc("MENU->"+NTrim(HelpReserved(,+1)),StrTran(cName,"~"),HelpReserved())
  438.   MD:Help:=HelpReserved()
  439.   MD:CheckIt:=true
  440.   MD:Name:=if(Eval(bAction,Count),"˚"," ")+" "+cName+" "
  441.   store value bPreBlock into MD:PreBlock
  442.   store value bPostBlock into MD:PostBlock
  443.   AAdd(::Avail,false)
  444.   AAdd(::Block,bAction)
  445.   AAdd(Stack:Top(),MD)
  446.   if nHotKey<>nil
  447.     AAdd(::HotKeys,{nHotKey,Count})
  448.     SetKey(nHotKey,{||(Cmd:=LastKey()),StuffKey(nSwapTask)})
  449.   endif
  450.   return(true)
  451.  
  452.  
  453. //*****************************************************************************
  454. // Menu:AddView(cName,cbWinName,View,nHotKey,nVKey,nEKey,nGKey,nLKey,nIKey,nFKey,nRKey,nMKey) --> true
  455. // shorcut for append standart view into menu
  456. //
  457. method function MenuAddView(cName,WinName,View,nHotKey,nVKey,nEKey,nGKey,nLKey,nIKey,nFKey,nRKey,nMKey)
  458.   default WinName to View:Name
  459.   if Stack:IsEmpty()
  460.     ::AddBar(cName,nHotKey,{|i|View:PreGoto(self,i)},{|i|View:PostGoto(self,i)})
  461.   else
  462.     ::AddMenu(cName,nHotKey,{|i|View:PreGoto(self,i)},{|i|View:PostGoto(self,i)})
  463.   endif
  464.     ::AddItem(ResTxt(035), {|i|View:View(i,StrTran(ResTxt(035),"~")+": "+WinName)},nVKey)
  465.     ::AddItem(ResTxt(036), {|i|View:Edit(i,StrTran(ResTxt(036),"~")+": "+WinName)},nEKey)
  466.     ::AddItem(ResTxt(037), {||View:Goto()}, nGKey)
  467.     ::AddItem(ResTxt(179), {||View:Locate()}, nLKey)
  468.     ::AddMenu(ResTxt(038), nIKey, {|i,Cs|View:SetIndex(i,,,Cs)})
  469.     ::PopSubLevel()
  470.     ::AddMenu(ResTxt(039),nFKey, {|i,Cs|View:SetFilter(i,,,Cs)})
  471.     ::PopSubLevel()
  472.     ::AddMenu(ResTxt(040),nRKey, {|i,Cs|View:SetReport(i,WinName,,,Cs)})
  473.     ::PopSubLevel()
  474.     ::AddMenu(ResTxt(041),nMKey)
  475.       ::AddMenu(ResTxt(042),, {|i,Cs|View:ModIndex(i,WinName,,,Cs)})
  476.       ::PopSubLevel()
  477.       ::AddMenu(ResTxt(043),,{|i,Cs|View:ModFilter(i,WinName,,,Cs)})
  478.       ::PopSubLevel()
  479.       ::AddMenu(ResTxt(044),,{|i,Cs|View:ModReport(i,WinName,,,Cs)})
  480.       ::PopSubLevel()
  481.     ::PopSubLevel()
  482.   ::PopSubLevel()
  483.   return(true)
  484.  
  485.  
  486. //*****************************************************************************
  487. // Menu:PopSubLevel() --> true
  488. // go one menu level up
  489. //
  490. method function MenuPopSubLevel()
  491.   Stack:Pop()
  492.   return(true)
  493.  
  494.  
  495. //*****************************************************************************
  496. // Menu:DisableItem(nItemID,lSubMenu) --> true
  497. // disable menu item
  498. //
  499. method function MenuDisableItem(nItemID,lSubMenu)
  500.   default lSubMenu to true
  501.   SetItem(self,nItemID,lSubMenu,false)
  502.   return(true)
  503.  
  504.  
  505. //*****************************************************************************
  506. // Menu:EnableItem(nItemID,lSubMenu) --> true
  507. // enable menu item
  508. //
  509. method function MenuEnableItem(nItemID,lSubMenu)
  510.   default lSubMenu to true
  511.   SetItem(self,nItemID,lSubMenu,true)
  512.   return(true)
  513.  
  514.  
  515. //-----------------------------------------------------------------------------
  516. // Menu::SetItem(nItemID,lSubMenu,lValue) --> true
  517. // set visibility menu item
  518. //
  519. static function SetItem(Menu,nItemID,lSubMenu,lValue)
  520.   local md
  521.   Menu:Avail[nItemID]:=lValue
  522.   if lSubMenu
  523.     md:=Menu:GetMD(nItemID)
  524.     SetSub(Menu,md,lValue)
  525.   endif
  526.   return(true)
  527.  
  528. static function SetSub(Menu,md,lValue)
  529.   AEval(md:Data,{|e|Menu:Avail[e:ID]:=lValue,if(!Empty(e:Data),SetSub(Menu,e,lValue),nil)})
  530.   return(true)
  531.  
  532.  
  533. //*****************************************************************************
  534. // Menu:GetMD(nItemID) --> MD object
  535. //return MD object, of this menu item
  536. //
  537. method function MenuGetMD(nItemID)
  538.   local md
  539.   ScanID(nItemID,0,@md,::Data)
  540.   return(md)
  541.  
  542. static function ScanID(nID,i,md,aData)
  543.   return(AScan(aData,{|e| if(++i==nID,(md:=e,true),if(!Empty(e:Data),ScanID(@nID,@i,@md,e:Data)>0,false))}))
  544.  
  545.  
  546. //*****************************************************************************
  547. // Menu:GetParentMD(nItemID) --> parent MD object
  548. //return Parents MD object, of this menu item
  549. //
  550. method function MenuGetParentMD(nItemID)
  551.   local md
  552.   ScanParentID(nItemID,0,@md,self)
  553.   return(md)
  554.  
  555. static function ScanParentID(nID,i,md,Menu)
  556.   return(AScan(Menu:Data,{|e| if(++i==nID,(md:=Menu,true),if(!Empty(e:Data),ScanParentID(@nID,@i,@md,e)>0,false))}))
  557.  
  558.  
  559. //*****************************************************************************
  560. // Menu:Process() --> true
  561. // main program loop
  562. //
  563. method function MenuProcess()
  564.   local i,OldCurs
  565.   if !ExistIntItems  //...............INTERNAL HELP ITEMS......................
  566.     HelpAssoc("SYS:->EDIT_PSW",    "",          HelpReserved(,+1))
  567.     HelpAssoc("SYS:->SUP_ID",      ResTxt(023), HelpReserved(,+1))
  568.     HelpAssoc("SYS:->SUP_PSW",     ResTxt(024), HelpReserved(,+1))
  569.     HelpAssoc("SYS:->SUP_MENU",    ResTxt(025), HelpReserved(,+1))
  570.     HelpAssoc("SYS:->SUP_LEVEL",   ResTxt(180), HelpReserved(,+1))
  571.     HelpAssoc("SYS:->SUP_IN_MENU", ResTxt(191), HelpReserved(,+1))
  572.     HelpAssoc("SYS:->IDX_NAME",    ResTxt(056), HelpReserved(,+1))
  573.     HelpAssoc("SYS:->IDX_KEY",     ResTxt(061), HelpReserved(,+1))
  574.     HelpAssoc("SYS:->IDX_UNIQ",    ResTxt(063), HelpReserved(,+1))
  575.     HelpAssoc("SYS:->FLT_NAME",    ResTxt(056), HelpReserved(,+1))
  576.     HelpAssoc("SYS:->FLT_EXPR",    ResTxt(062), HelpReserved(,+1))
  577.     HelpAssoc("SYS:->FLT_PROP",    ResTxt(181), HelpReserved(,+1))
  578.     HelpAssoc("SYS:->RPT_NAME",    ResTxt(056), HelpReserved(,+1))
  579.     HelpAssoc("SYS:->RPT_TOP",     ResTxt(047), HelpReserved(,+1))
  580.     HelpAssoc("SYS:->RPT_FIELDS",  ResTxt(048), HelpReserved(,+1))
  581.     HelpAssoc("SYS:->RPT_BOTTOM",  ResTxt(049), HelpReserved(,+1))
  582.     HelpAssoc("SYS:->RPT_ONLY",    ResTxt(193), HelpReserved(,+1))
  583.     HelpAssoc("SYS:->RPT_IN_SEL",  ResTxt(082), HelpReserved(,+1))
  584.     HelpAssoc("SYS:->RPT_IN_TITLE",ResTxt(082), HelpReserved(,+1))
  585.     HelpAssoc("SYS:->RPT_IN_TOT",  ResTxt(084), HelpReserved(,+1))
  586.     HelpAssoc("SYS:->RPT_IN_SUBT", ResTxt(085), HelpReserved(,+1))
  587.     HelpAssoc("SYS:->PAGE_NO",     ResTxt(195), HelpReserved(,+1))
  588.     ExistIntItems:=true
  589.   endif
  590.   if GetLastDbf():lNew //..............FILL THE HELP DBF.......................
  591.     DOut(ResTxt(190))
  592.     select (cHelp)
  593.     for i:=1 to HelpReserved()  //+20 internal items ???
  594.       net append blank continue
  595.       field->Text:=cr_lf+"  "+ResTxt(188)
  596.       field->ColSize:=Len(ResTxt(188))+4
  597.       field->RowSize:=3
  598.     endfor
  599.     net unlock
  600.     GetLastDbf():lNew:=false
  601.   endif
  602.   if UserNo()<=1 //......................PROTECTION............................
  603.     AFill(::Avail,true)
  604.   else
  605.     (cBasic)->(DbGoto(UserNo()))
  606.     IEval(Len(::Avail),{|i|::Avail[i]:=(SubStr((cBasic)->S,i,1)=="˚")})
  607.   endif
  608.   select (cBasic)
  609.   Cmd:=K_F10
  610.   @ 0,0 say Replicate(" ",MaxCol()+1) color m->Color:Menu
  611.   DOut(ResTxt(174))
  612.   SaveHelpIdx({16})
  613.   repeat                     //......................MAIN PROGRAM LOOP.........
  614.     OldCurs:=SetCursor(SC_NONE)
  615.     if ::NewTask<>nil
  616.       i:=::NewTask
  617.       ::NewTask:=nil
  618.     else
  619.       if Cmd==K_F10; i:=::BarEntry({})
  620.       elseif Cmd==0; i:=0
  621.       else
  622.         if (i:=AScan(::HotKeys,{|e|e[1]==Cmd}))>0    //Accelerator key not found
  623.           i:=::HotKeys[i,2]                          //item_id
  624.           if ::Avail[i]                              //available_item
  625.             if ValType(::Block[i])=="A"
  626.               i:=::BarEntry(AClone(::Block[i]))   //menu entry with copy accelerators
  627.             endif
  628.           else
  629.             i:=0  //item is not available
  630.           endif
  631.         endif
  632.       endif
  633.     endif
  634.     SetCursor(OldCurs)
  635.     SetLastKey(K_ENTER)  //overwrite K_ESC (exit from menu)
  636.     if i==0
  637.       Cmd:=K_F10
  638.       RestartTask()
  639.     elseif Empty(::Block[i])
  640.       Cmd:=K_F10
  641.       RestartTask()
  642.     else
  643.       Cmd:=0
  644.       Eval(::Block[i],i)
  645.     endif
  646.   until Cmd==nQuitRequest
  647.   RestHelpIdx()
  648.   return(true)
  649.  
  650.  
  651. //*****************************************************************************
  652. // Menu:BarEntry(aAccelerators) --> bAction
  653. // main menu loop, return bAction of selected menu item
  654. //
  655. method function MenuBarEntry(aAcc)
  656.   local Idx,Ch,nAction,i
  657.   SaveDOut(ResTxt(142))
  658.   Idx:=if(!Empty(aAcc),(StuffKey(K_ENTER),ATrueDel(aAcc,1)),::Idx)
  659.   TrueIdx(self,@Idx,0)
  660.   nAction:=-1 //do nothing
  661.   repeat
  662.     ShowBar(self,Idx)
  663.     repeat
  664.       Ch:=GetKey(0)    //MUST BE GetKey(), (do not use InkeyWait()!)
  665.       AboutOff(true)  //make something only first pass
  666.       if Ch==K_F1
  667.         HelpKeys()
  668.       elseif Ch==K_SH_F1
  669.         ReadHelpVar("MENU->"+NTrim(::Data[Idx]:Help))
  670.         HelpField(false)
  671.         ReadHelpVar("")
  672.       endif
  673.     until !(Ch==K_SH_F1)
  674.     do case
  675.       case Ch==K_ESC
  676.         if !Empty(GetTList())
  677.           nAction:=0  //restart_task
  678.         endif
  679.       case Ch==K_ENTER or Ch==K_DOWN
  680.         nAction:=::ItemEntry(::Data[Idx],0,aAcc)
  681.         if LastKey()==K_LEFT or LastKey()==K_RIGHT
  682.           TrueIdx(self,@Idx,if(LastKey()==K_LEFT,-1,+1))
  683.           StuffKey(K_DOWN)
  684.         endif
  685.       case Ch==K_LEFT
  686.         TrueIdx(self,@Idx,-1)
  687.       case Ch==K_RIGHT
  688.         TrueIdx(self,@Idx,+1)
  689.       case Ch==K_HOME
  690.         Idx:=1
  691.         TrueIdx(self,@Idx,0)
  692.       case Ch==K_END
  693.         Idx:=Len(::Data)
  694.         TrueIdx(self,@Idx,0)
  695.       otherwise
  696.         Ch:=Upper(Chr(Ch))
  697.         if "A"<=Ch and Ch<="Z"
  698.           Ch:="~"+Ch
  699.           if (i:=AScan(::Data,{|e|At(Ch,Upper(e:Name))>0}))>0
  700.             Idx:=i
  701.             StuffKey(K_ENTER)
  702.           endif
  703.         endif
  704.     endcase
  705.   until nAction>=0
  706.   ::Idx:=Idx     //save selection
  707.   ShowBar(self,0)  //hide selection
  708.   RestDOut()
  709.   return(nAction)
  710.  
  711.  
  712. //-----------------------------------------------------------------------------
  713. // Menu::TrueIdx(@Idx,nDirection) --> true
  714. // evaluate true Idx for bar menu, check availability of the bar item
  715. //
  716. static function TrueIdx(Menu,Idx,nDirection)
  717.   if nDirection==0; Idx--; nDirection++; endif
  718.   repeat
  719.     Idx+=nDirection
  720.     if Idx<1 and Set(_SET_WRAP); Idx:=Len(Menu:Data)
  721.     elseif Idx>Len(Menu:Data) and Set(_SET_WRAP); Idx:=1
  722.     elseif Idx<1; Idx:=1; if !(Menu:Avail[Menu:Data[Idx]:ID]); nDirection:=+1; endif
  723.     elseif Idx>Len(Menu:Data); Idx:=Len(Menu:Data); if !(Menu:Avail[Menu:Data[Idx]:ID]); nDirection:=-1; endif
  724.     endif
  725.   until Menu:Avail[Menu:Data[Idx]:ID]
  726.   return(true)
  727.  
  728.  
  729. //-----------------------------------------------------------------------------
  730. // Menu::ShowBar(Idx) --> true
  731. // show menu bar, check validation for current item, can change Idx.
  732. //
  733. static function ShowBar(Menu,Idx)
  734.   local i,e,MD
  735.   local aClr:=ListAsArray(Menu:Color)
  736.   local object Cursor of Cursor
  737.   AAdd(aClr,if(m->tColor==1,GetBack(aClr[nNormal]),GetFore(aClr[nNormal]))+"/"+GetBack(aClr[nEnhanced]))
  738.   DispBegin()
  739.   SetPos(0,0)
  740.   DispOut(" ",aClr[nNormal])
  741.   Cursor:Get()
  742.   for i:=1 to Len(Menu:Data)
  743.     e:=Menu:Data[i]
  744.     if Idx==i; Cursor:Get(); endif
  745.     DrawItem(e:Name,Menu:Avail[e:ID],(Idx==i),aClr)
  746.   endfor
  747.   Cursor:Size:=SC_NONE
  748.   Cursor:Col--
  749.   Cursor:Set()
  750.   DispEnd()
  751.   return(true)
  752.  
  753.  
  754. //-------------------------------------------
  755. // DrawItem(It,SelIt,HiIt) --> true
  756. // draw one menu items for OChoice
  757. //
  758. static function DrawItem(It,SelIt,HiIt,Clr)
  759.   local cn,cl,i:=At("~",It)
  760.   if m->tColor<>0
  761.     cn:=Clr[if(SelIt,if(HiIt,nExtension,nNormal),nDisable)]
  762.     cl:=Clr[if(SelIt,if(HiIt,nSelected,nLetter),nDisable)]
  763.   else
  764.     cn:=Clr[if(SelIt,if(HiIt,nSelected,nNormal),nDisable)]
  765.     cl:=Clr[if(SelIt,nLetter,nDisable)]
  766.   endif
  767.   DispOut(" ",cn)
  768.   if i>0
  769.     DispOut(Left(It,i-1),cn)
  770.     DispOut(SubStr(It,i+1,1),cl)   //letter
  771.     DispOut(SubStr(It,i+2),cn)
  772.   else
  773.     DispOut(It,cn)
  774.   endif
  775.   DispOut(" ",cn)
  776.   return(true)
  777.  
  778.  
  779. //*****************************************************************************
  780. // Menu:ItemEntry(MD,CurSize,aAccelerator) --> nAction
  781. // process one menu entry
  782. //
  783. method function MenuItemEntry(MD,CurSize,aAcc)
  784.   local Mnu,Help,Items,SelItems,nAction,lExit,i,e,Row,Col,c
  785.   if !Eval(MD:PreBlock,MD:ID,CurSize); return(-1); endif //do nothing
  786.   SaveDOut(ResTxt(141))
  787.   if Empty(MD:Data)
  788.     if LastKey()==K_ENTER //select
  789.       if MD:CheckIt
  790.         e:=::Block[MD:ID]
  791.         Eval(e,MD:ID,!Eval(e,MD:ID))  //swap value
  792.         Row:=Row()                    //and draw it
  793.         Col:=Col()
  794.         @ Row,Col-CurSize say if(Eval(e,MD:ID),"˚"," ") color ListAsArray(m->Color:Menu)[nSelected]
  795.         SetPos(Row,Col)
  796.         if Set(_SET_BELL); Bell(); endif
  797.         //
  798.         if !Empty(MD:PostBlock); Eval(MD:PostBlock,MD:ID,CurSize); endif
  799.         return(-1) //0
  800.       else  //standart action
  801.         if !Empty(MD:PostBlock); Eval(MD:PostBlock,MD:ID,CurSize); endif
  802.         return(MD:ID)
  803.       endif
  804.     else  //exit, no action?
  805.       if !Empty(MD:PostBlock); Eval(MD:PostBlock,MD:ID,CurSize); endif
  806.       return(-1)  //do nothing
  807.     endif
  808.   endif
  809.   Help:={}
  810.   Items:={}
  811.   SelItems:={}
  812.   for i:=1 to Len(MD:Data)
  813.     e:=MD:Data[i]
  814.     if e:CheckIt
  815.       e:Name:=if(Eval(::Block[e:ID]),"˚"," ")+SubStr(e:Name,2)
  816.     endif
  817.     AAdd(Help,e:Help)
  818.     AAdd(Items,e:Name)
  819.     AAdd(SelItems,::Avail[e:ID])
  820.   endfor
  821.   lExit:=false
  822.   if !Empty(aAcc); MD:Idx:=ATrueDel(aAcc,1); lExit:=true; endif
  823.   object Mnu of Mnu
  824.   Mnu:Choice:=MD:Idx
  825.   Mnu:Init(,,,CurSize,Items,SelItems,::Color)
  826.   Mnu:Help:=Help
  827.   repeat
  828.     nAction:=-1
  829.     if !lExit
  830.       MD:Idx:=Abs(Mnu:Process())
  831.     endif
  832.     if Mnu:Choice>0 or (LastKey()==K_RIGHT and CurSize<>0)  //down
  833.       nAction:=::ItemEntry(e:=MD:Data[MD:Idx],AWidth(Items,{|e|Len(e)-if(At("~",e)>0,1,0)}),aAcc)
  834.       if e:CheckIt
  835.         c:=if(Eval(::Block[e:ID],e:ID),"˚"," ")
  836.         Items[MD:Idx]:=c+SubStr(Items[MD:Idx],2)
  837.       endif
  838.       lExit:=(nAction>=0)
  839.     else  //up
  840.       lExit:=true
  841.       if LastKey()==nSwapTask; nAction:=0; endif
  842.       if SetQuickEsc() and LastKey()==K_ESC; StuffKey(K_ESC); endif
  843.     endif
  844.   until lExit and Eval(MD:PostBlock,MD:ID,CurSize)
  845.   Mnu:Done()
  846.   RestDOut()
  847.   return(nAction)
  848.  
  849.  
  850. //*****************************************************************************
  851. // Menu:Done() --> true/false
  852. // destroy this object.
  853. //
  854. method function MenuDone(lConfirm)
  855.   local lExit:=true
  856.   default lConfirm to true
  857.   if lConfirm and Alert(ResTxt(097),ResTxt(123))<>1; return(false); endif
  858.   while lExit and !Empty(GetTList()); lExit:=ATail(GetTList()):Done(); endwhile
  859.   if lExit
  860.     Stack:=nil
  861.     AEval(::HotKeys,{|e|SetKey(e[1],nil)})
  862.     SetKey(K_F10,nil)
  863.     Cmd:=nQuitRequest
  864.     ActiveMenu:=nil
  865.   endif
  866.   return(lExit)
  867.  
  868. //------------------------------------------------------- eof (c)JHK ----------
  869.  
  870.